home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / macberon.sit / MacOberon 2.4(0) / PopupElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1992-01-27  |  9.5 KB  |  204 lines
  1. Syntax10.Scn.Fnt
  2. MODULE PopupElems;    (* Michael Franz, 27.1.92 -- "Hypertext without Surprises" *)
  3.     IMPORT
  4.         Oberon, Input, Display, Viewers, Files, Fonts, Printer, Texts, TextFrames, MenuViewers, WriteFrames, WritePrinter;
  5.     CONST
  6.         edw=4; edh=2; mdw=3; mdh=1; CR=0DX;    (* margins of element box and menu box *)
  7.     TYPE
  8.         PopupElem=POINTER TO PopupElemDesc;
  9.         PopupElemDesc=RECORD (Texts.ElemDesc)
  10.             name: ARRAY 32 OF CHAR;
  11.             menu: Texts.Text; n, def, wid, lsp, dsc: INTEGER    (* number of items, default, width, line space, descender *)
  12.         END;
  13.         EditFrame=POINTER TO EditFrameDesc;
  14.         EditFrameDesc=RECORD (TextFrames.FrameDesc)
  15.             elem: PopupElem
  16.         END;
  17.         buf: Texts.Buffer;    (* copy buffer *)
  18. (* auxiliary *)
  19.     PROCEDURE Min(x, y: INTEGER): INTEGER;
  20.     BEGIN    IF    x<y    THEN    RETURN x    ELSE    RETURN y    END
  21.     END Min;
  22.     PROCEDURE Max(x, y: INTEGER): INTEGER;
  23.     BEGIN    IF    x>y    THEN    RETURN x    ELSE    RETURN y    END
  24.     END Max;
  25. (* change propagation *)
  26.     PROCEDURE SetupElem(E: PopupElem; fnt: Fonts.Font);
  27.         VAR i, wid, dx, x, y, w, h: INTEGER; p: LONGINT;
  28.     BEGIN    i:=0; wid:=2*edw+4;
  29.         LOOP
  30.             IF    E.name[i]=0X    THEN    E.W:=(wid+1)*Display.Unit; E.H:=(fnt.height-fnt.minY+2*edh+2)*Display.Unit; RETURN
  31.             ELSE    Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, p); INC(wid, dx); INC(i)    END
  32.         END
  33.     END SetupElem;
  34.     PROCEDURE SetupMenu(E: PopupElem);
  35.         VAR R: Texts.Reader; ch: CHAR; wid, dx, x, y, w, h: INTEGER; p: LONGINT;
  36.     BEGIN    Texts.OpenReader(R, E.menu, 0); E.wid:=0; E.n:=1; E.lsp:=0; wid:=0;
  37.         LOOP    Texts.Read(R, ch);
  38.             IF    R.eot    THEN    E.wid:=Max(E.wid, wid); E.def:=Min(E.def, E.n); RETURN
  39.             ELSIF    ch=CR    THEN    E.wid:=Max(E.wid, wid); wid:=0; INC(E.n)
  40.             ELSE    E.lsp:=Max(E.lsp, R.fnt.height); E.dsc:=Min(E.dsc, R.fnt.minY);
  41.                 Display.GetChar(R.fnt.raster, ch, dx, x, y, w, h, p); INC(wid, dx)
  42.             END
  43.         END
  44.     END SetupMenu;
  45. (* interactive editing of popup menus *)
  46.     PROCEDURE* EditHandle(F: Display.Frame; VAR M: Display.FrameMsg);
  47.         VAR F1: EditFrame;
  48.     BEGIN
  49.         WITH    F:EditFrame    DO    TextFrames.Handle(F, M);
  50.             IF    ((M IS Oberon.InputMsg) & (M(Oberon.InputMsg).id=Oberon.consume)) OR (M IS TextFrames.UpdateMsg)    THEN
  51.                 SetupMenu(F.elem)
  52.             ELSIF    M IS Oberon.CopyMsg    THEN    NEW(F1);
  53.                 TextFrames.Open(F1, F.handle, F.text, F.org, F.col, F.left, F.right, F.top, F.bot, F.lsp); F1.elem:=F.elem; M(Oberon.CopyMsg).F:=F1
  54.             END
  55.         END
  56.     END EditHandle;
  57.     PROCEDURE OpenEditor(E: PopupElem);
  58.         VAR V: Viewers.Viewer; F: EditFrame; x, y: INTEGER;
  59.     BEGIN    Oberon.AllocateUserViewer(Oberon.Par.vwr.X, x, y); NEW(F); F.elem:=E;
  60.         TextFrames.Open(F, EditHandle, E.menu, 0, Display.black, TextFrames.left, TextFrames.right, TextFrames.top, TextFrames.bot, 0);
  61.         V:=MenuViewers.New(TextFrames.NewMenu(E.name, "System.Close  System.Grow"), F, TextFrames.menuH, x, y)
  62.     END OpenEditor;
  63. (* file input/output *)
  64.     PROCEDURE Load(VAR R: Files.Rider; E: PopupElem);
  65.         VAR F: Files.File; ch: CHAR; i: INTEGER; pos, len: LONGINT;
  66.     BEGIN    i:=0;    REPEAT    Files.Read(R, ch); E.name[i]:=ch; INC(i)    UNTIL    ch=0X;
  67.         E.name[i-1]:="."; E.name[i]:="."; E.name[i+1]:="."; E.name[i+2]:=0X; SetupElem(E, Fonts.Default);
  68.         Files.Read(R, ch); E.def:=ORD(ch); E.menu:=TextFrames.Text("");
  69.         pos:=Files.Pos(R)+2; F:=Files.Base(R); Texts.Load(E.menu, F, pos, len); Files.Set(R, F, pos+len)
  70.     END Load;
  71.     PROCEDURE Store(VAR R: Files.Rider; E: PopupElem);
  72.         VAR F: Files.File; i: INTEGER; pos, len: LONGINT;
  73.     BEGIN    i:=0;    WHILE    E.name[i] # 0X    DO    INC(i)    END;
  74.         Files.WriteBytes(R, E.name, i-3); Files.Write(R, 0X); Files.Write(R, CHR(E.def MOD 128));
  75.         pos:=Files.Pos(R); F:=Files.Base(R); len:=E.menu.len; Texts.Store(E.menu, F, pos, len); Files.Set(R, F, pos+len)
  76.     END Store;
  77. (* graphics *)
  78.     PROCEDURE Box(col, X, Y, W, H: INTEGER);
  79.     BEGIN
  80.         Display.ReplConst(col, X+1, Y+1, W-2, 1, Display.replace);
  81.         Display.ReplConst(col, X+1, Y+H-2, W-2, 1, Display.replace);
  82.         Display.ReplConst(col, X+1, Y+2, 1, H-4, Display.replace);
  83.         Display.ReplConst(col, X+W-2, Y+2, 1, H-4, Display.replace);
  84.         Display.ReplConst(col, X+4, Y, W-4, 1, Display.replace);
  85.         Display.ReplConst(col, X+W-1, Y+1, 1, H-4, Display.replace);
  86.         Display.ReplConst(Display.black, X+2, Y+2, W-4, H-4, Display.replace)
  87.     END Box;
  88.     PROCEDURE PrintElem(E: PopupElem; X, Y: INTEGER; fnt: Fonts.Font);
  89.         VAR W, H: INTEGER;
  90.     BEGIN    W:=SHORT((E.W-1) DIV WritePrinter.Unit); H:=SHORT(E.H DIV WritePrinter.Unit);
  91.         Printer.ReplConst(X, Y, W, 2);
  92.         Printer.ReplConst(X, Y+H-2, W, 2);
  93.         Printer.ReplConst(X, Y+2, 2, H-4);
  94.         Printer.ReplConst(X+W-2, Y+2, 2, H-4);
  95.         Printer.String(X+edw+2, Y+edh+2+fnt.minY, E.name, fnt.name)
  96.     END PrintElem;
  97.     PROCEDURE DrawElem(E: PopupElem; col, X, Y: INTEGER; fnt: Fonts.Font);
  98.         VAR i, dx, x, y, w, h: INTEGER; p: LONGINT;
  99.     BEGIN    Box(col, X, Y, SHORT((E.W-1) DIV WriteFrames.Unit), SHORT(E.H DIV WriteFrames.Unit));
  100.         INC(X, edw+2); INC(Y, edh+2-fnt.minY); i:=0;
  101.         WHILE    E.name[i] >= " "    DO    Display.GetChar(fnt.raster, E.name[i], dx, x, y, w, h, p);
  102.             Display.CopyPattern(col, p, X+x, Y+y, Display.replace); INC(X, dx); INC(i)
  103.         END
  104.     END DrawElem;
  105.     PROCEDURE DrawMenu(E: PopupElem; X, Y, W, H: INTEGER);
  106.         VAR R: Texts.Reader; ch: CHAR; X0, dx, x, y, w, h: INTEGER; p: LONGINT;
  107.     BEGIN    Box(Display.white, X, Y, W, H); Texts.OpenReader(R, E.menu, 0); X0:=X+mdw+2; X:=X0; Y:=Y+H-E.lsp-E.dsc-mdh-2;
  108.         LOOP    Texts.Read(R, ch);
  109.             IF    R.eot    THEN    RETURN
  110.             ELSIF    ch=CR    THEN    Y:=Y-E.lsp; X:=X0
  111.             ELSE    Display.GetChar (R.fnt.raster, ch, dx, x, y, w, h, p);
  112.                 Display.CopyPattern(Display.white, p, X+x, Y+y, Display.replace); INC(X, dx)
  113.             END
  114.         END
  115.     END DrawMenu;
  116. (* actions *)
  117.     PROCEDURE Show(E: PopupElem; X, Y, W, H: INTEGER; VAR cmd: INTEGER);
  118.         VAR mx, my, top, bot, left, right, newCmd: INTEGER; keys: SET;
  119.     BEGIN    left:=X+3; right:=X+W-3; bot:=Y+mdh+3; top:=Y+H-mdh-2;
  120.         Oberon.RemoveMarks(X, Y, W, H); Oberon.FadeCursor(Oberon.Mouse);
  121.         Display.CopyBlock(X, Y, W, H, X, -H, Display.replace); DrawMenu(E, X, Y, W, H);
  122.         Display.ReplConst(Display.white, X+3, top-cmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert);
  123.         REPEAT    Input.Mouse(keys, mx, my); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my);
  124.             IF    keys*{0,2} # {}    THEN    Oberon.FadeCursor(Oberon.Mouse); Display.CopyBlock(X, -H, W, H, X, Y, Display.replace);
  125.                 IF    0 IN keys    THEN    OpenEditor(E)    END;
  126.                 REPEAT    Input.Mouse(keys, mx, my); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my)    UNTIL keys={};
  127.                 cmd:=-1; RETURN
  128.             ELSIF    (mx>=left) & (mx<=right) & (my>=bot) & (my<=top)    THEN    newCmd:=(top-my) DIV E.lsp;
  129.                 IF    newCmd # cmd    THEN
  130.                     IF    cmd # -1    THEN    Display.ReplConst(Display.white, X+3, top-cmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert)    END;
  131.                     Display.ReplConst(Display.white, X+3, top-newCmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert); cmd:=newCmd
  132.                 END
  133.             ELSIF    cmd # -1    THEN
  134.                 Display.ReplConst(Display.white, X+3, top-cmd*E.lsp-E.lsp, W-6, E.lsp, Display.invert); cmd:=-1
  135.             END
  136.         UNTIL    keys={};
  137.         Oberon.FadeCursor(Oberon.Mouse); Display.CopyBlock(X, -H, W, H, X, Y, Display.replace);
  138.     END Show;
  139.     PROCEDURE Popup(E: PopupElem; X, Y: INTEGER; F: Display.Frame);
  140.         VAR W, H, mx, my, i, j, cmd, res: INTEGER; cmdStr: ARRAY 32 OF CHAR; r: Texts.Reader; ch: CHAR; keys: SET;
  141.     BEGIN    Input.Mouse(keys, mx, my); W:=E.wid+2*mdw+4; H:=E.n*E.lsp+2*mdh+4;
  142.         Y:=Max(my-H+E.lsp+E.def*E.lsp, 0); cmd:=E.def;
  143.         IF    X+W > Display.Width    THEN    X:=Display.Width-W    END;
  144.         IF    Y+H > Display.Height    THEN    Y:=Display.Height-H    END;
  145.         Show(E, X, Y, W, H, cmd);
  146.         IF    cmd > -1    THEN    E.def:=cmd; j:=0; Texts.OpenReader(r, E.menu, 0); Texts.Read(r, ch);
  147.             WHILE    j < cmd    DO
  148.                 IF    ch=CR     THEN    INC(j)    END;
  149.                 Texts.Read(r, ch)
  150.             END;
  151.             i:=0;    WHILE    (ch>" ") & (ch#CR) & (i<31)    DO    cmdStr[i]:=ch; INC(i); Texts.Read(r, ch)    END;    cmdStr[i]:=0X;
  152.             Oberon.Par.frame:=F; Oberon.Par.text:=E.menu; Oberon.Par.pos:=Texts.Pos(r); Oberon.Call(cmdStr, Oberon.Par, FALSE, res)
  153.         END
  154.     END Popup;
  155. (* element *)
  156.     PROCEDURE* Handle(E: Texts.Elem; VAR msg: Texts.ElemMsg);
  157.         VAR e: PopupElem;
  158.     BEGIN
  159.         WITH    E:PopupElem    DO
  160.             IF    msg IS WriteFrames.DisplayMsg    THEN
  161.                 WITH    msg:WriteFrames.DisplayMsg    DO
  162.                     IF    msg.prepare    THEN    SetupElem(E, msg.fnt)
  163.                     ELSE    DrawElem(E, msg.col, msg.X0, msg.Y0, msg.fnt)    END
  164.                 END
  165.             ELSIF    msg IS WritePrinter.PrintMsg    THEN
  166.                 WITH    msg:WritePrinter.PrintMsg    DO
  167.                     IF    ~msg.prepare    THEN    PrintElem(E, msg.X0, msg.Y0, msg.fnt)    END
  168.                 END
  169.             ELSIF    msg IS Texts.CopyMsg    THEN
  170.                 WITH    msg:Texts.CopyMsg    DO
  171.                     NEW(e); Texts.CopyElem(E, e); e.name:=E.name; e.def:=E.def; e.wid:=E.wid; e.lsp:=E.lsp; e.dsc:=E.dsc; e.n:=E.n;
  172.                     e.menu:=TextFrames.Text(""); Texts.Save(E.menu, 0, E.menu.len, buf); Texts.Append(e.menu, buf); msg.e:=e
  173.                 END
  174.             ELSIF    msg IS Texts.IdentifyMsg    THEN
  175.                 WITH    msg:Texts.IdentifyMsg    DO
  176.                     msg.mod:="PopupElems"; msg.proc:="Alloc"
  177.                 END
  178.             ELSIF    msg IS Texts.FileMsg    THEN
  179.                 WITH    msg:Texts.FileMsg    DO
  180.                     IF    msg.id=Texts.load    THEN    Load(msg.r, E); SetupMenu(E)
  181.                     ELSIF    msg.id=Texts.store    THEN    Store(msg.r, E)    END
  182.                 END
  183.             ELSIF    msg IS WriteFrames.TrackMsg    THEN
  184.                 WITH    msg:WriteFrames.TrackMsg    DO
  185.                     IF    msg.keys={1}    THEN    Popup(E, msg.X0, msg.Y0, msg.frame)    END
  186.                 END
  187.             END
  188.         END
  189.     END Handle;
  190.     PROCEDURE Alloc*;
  191.         VAR E: PopupElem;
  192.     BEGIN    NEW(E); E.handle:=Handle; Texts.new:=E
  193.     END Alloc;
  194.     PROCEDURE Insert*;
  195.         VAR E: PopupElem; S: Texts.Scanner; i: INTEGER;
  196.     BEGIN    NEW(E); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  197.         IF    S.class # Texts.String    THEN    S.s:="Popup"    END;
  198.         i:=0;    REPEAT    E.name[i]:=S.s[i]; INC(i)    UNTIL    S.s[i]=0X;
  199.         E.name[i]:="."; E.name[i+1]:="."; E.name[i+2]:="."; E.name[i+3]:=0X; SetupElem(E, Fonts.Default);
  200.         E.menu:=TextFrames.Text(""); SetupMenu(E); E.handle:=Handle; WriteFrames.CopyToFocus(E)
  201.     END Insert;
  202. BEGIN    NEW(buf); Texts.OpenBuf(buf)
  203. END PopupElems.
  204.